{ *******************************************************************************
  Copyright 2010-2011 Daniele Teti

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
  ******************************************************************************** }

unit dorm.adapter.ADO.SqlServer9;

interface

uses
  dorm.Commons,
  dorm.Mappings,
  classes,
  SysUtils,
  DB,
  AdoDb,
  dorm.adapter.ADO.Factory,
  Rtti,
  dorm,
  superobject,
  TypInfo,
  FMTBcd,
  dorm.Filters,
  dorm.Collections,
{$IF CompilerVersion > 22}
  System.Generics.Collections,
{$ELSE}
  Generics.Collections,
{$IFEND}
  Variants;


type
  TSqlServer9ADOPersistStrategy = class(TdormInterfacedObject, IdormPersistStrategy)
  strict protected
    SS9: TADOFactory;
    FLogger: IdormLogger;
    FKeyType: TdormKeyType;
    FNullKeyValue: TValue;
    FLastInsertOID: TValue;
    function CreateADOFactory(Conf: ISuperObject): TADOFactory; virtual;
    function CreateObjectFromADODataset(ARttiType: TRttiType; ADataSet: TADOQuery; AFieldsMapping: TMappingFieldList): TObject;
    function LoadObjectFromADODataset(ARttiType: TRttiType; ADataset: TADOQuery;
      AFieldsMapping: TMappingFieldList; AObject: TObject): Boolean;
    function GetLogger: IdormLogger;

    procedure SetADOParameterValue(aQuery: TADOQuery; aParamName: string; aFieldType: string; aValue: TValue);
    function FillPrimaryKeyParam(Query: TADOQuery; AParamName: String; const Value: TValue): TValue;
  public
    //
    // Interface
    //
    function Insert(ARttiType: TRttiType; AObject: TObject; ATableName: string;
      AFieldsMapping: TMappingFieldList): TValue;
    function Update(ARttiType: TRttiType; AObject: TObject; ATableName: string;
      AFieldsMapping: TMappingFieldList): TValue;
    function Load(ARttiType: TRttiType; ATableName: string;
      AFieldsMapping: TMappingFieldList; const Value: TValue)
      : TObject; overload;
    function List(ARttiType: TRttiType; ATableName: string;
      AFieldsMapping: TMappingFieldList;
      AdormSearchCriteria: IdormSearchCriteria): TObjectList<TObject>;
    procedure FillList(AList: TObject; ARttiType: TRttiType;
      ATableName: string; AFieldsMapping: TMappingFieldList;
      AdormSearchCriteria: IdormSearchCriteria); overload;
    function Delete(ARttiType: TRttiType; AObject: TObject; ATableName: string;
      AFieldsMapping: TMappingFieldList): TObject;
    function GetKeyType: TdormKeyType;
    procedure DeleteAll(ATableName: string);
    function Count(ATableName: string): Int64;
    function GetLastInsertOID: TValue;
    procedure ConfigureStrategy(ConfigurationInfo: ISuperObject);
    procedure InitStrategy;
    procedure StartTransaction;
    procedure Commit;
    procedure Rollback;
    function InTransaction: boolean;
    function IsNullKey(const Value: TValue): boolean;
    function GetNullKeyValue: TValue;
    procedure SetLogger(ALogger: IdormLogger);
    function RawExecute(SQL: string): Int64;
    function ExecuteAndGetFirst(SQL: string): Int64;
    function EscapeString(const Value: string): string;
    function EscapeDate(const Value: TDate): string;
    function EscapeDateTime(const Value: TDate): string;
    function GetSelectSQL(Criteria: TdormCriteria;
      AMappingTable: TMappingTable): string;

    destructor Destroy; override;
    class procedure register;
  end;

  TSQLServer9ADOIdentity = class(TdormInterfacedObject, IdormKeysGenerator)
  private
    FPersistStrategy: IdormPersistStrategy;
  public
    function NewStringKey(const Entity: string): string;
    function NewIntegerKey(const Entity: string): UInt64;
    procedure SetPersistStrategy(const PersistentStrategy
      : IdormPersistStrategy);
    class procedure RegisterClass;
  end;

implementation

uses
  dorm.Utils,
  StrUtils;

function TSqlServer9ADOPersistStrategy.Update(ARttiType: TRttiType; AObject: TObject;
  ATableName: string; AFieldsMapping: TMappingFieldList): TValue;
var
  field: TMappingField;
  SQL: string;
  Query: TADOQuery;
  pk_idx: Integer;
  v: TValue;
  sql_fields_names: string;
  pk_field: string;
begin
  sql_fields_names := '';
  for field in AFieldsMapping do
    if not field.IsPK then
      sql_fields_names := sql_fields_names + ',' + field.FieldName + '= :'+field.FieldName;
  System.Delete(sql_fields_names, 1, 1);

  pk_field := AFieldsMapping[GetPKMappingIndex(AFieldsMapping)].FieldName;
  SQL := Format('UPDATE %S SET %S WHERE %S = :'+pk_field, [ATableName, sql_fields_names,
    pk_field]);

  GetLogger.Debug(AFieldsMapping[GetPKMappingIndex(AFieldsMapping)].FieldName);

  GetLogger.Debug('PREPARING: ' + SQL);

  Query := SS9.GetQuery;
  Query.SQL.Text := SQL;
  try
    for field in AFieldsMapping do
    begin
      v := TdormUtils.GetField(AObject, field.name);

      SetADOParameterValue(Query, field.FieldName, field.FieldType, v);
    end;

    pk_idx := GetPKMappingIndex(AFieldsMapping);

    v := ARttiType.GetProperty(AFieldsMapping[pk_idx].name).GetValue(AObject);

    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);

    Query.ExecSQL;
  finally
    //Query.Free;
  end;
end;

procedure TSqlServer9ADOPersistStrategy.Commit;
begin
  //if SS9.GetConnection.InTransaction then SS9.GetConnection.CommitTrans;
end;

procedure TSqlServer9ADOPersistStrategy.ConfigureStrategy(ConfigurationInfo
  : ISuperObject);
begin
  SS9 := CreateADOFactory(ConfigurationInfo);

  if (SameText(ConfigurationInfo.S['key_type'], 'integer')) then
  begin
    FKeyType := ktInteger;
    FNullKeyValue := ConfigurationInfo.I['null_key_value']
  end
  else
    raise EdormException.Create('Unknown key type');
  inherited;
end;

function TSqlServer9ADOPersistStrategy.Count(ATableName: string): Int64;
var
  SQL: string;
  Query: TADOQuery;
begin
  Result := -1;
  SQL := 'SELECT COUNT(*) AS CNT FROM ' + ATableName;
  GetLogger.Debug('PREPARING: ' + SQL);

  Query := SS9.GetQuery;
  try
    Query.SQL.Text := SQL;
    Query.Open;
    try
      Result := Query['CNT'];
      Query.Close;
    except
      on e: exception do
      begin
        GetLogger.Debug('TSqlServer9PersistStrategy.Count: ' +e.Message);
      end;
    end;
  finally
    //Query.Free;
  end;
end;

function TSqlServer9ADOPersistStrategy.CreateADOFactory(Conf: ISuperObject): TADOFactory;
begin
  Result := TADOFactory.Create(Conf);
end;

function TSqlServer9ADOPersistStrategy.Delete(ARttiType: TRttiType; AObject: TObject;
  ATableName: string; AFieldsMapping: TMappingFieldList): TObject;
var
  pk_idx: Integer;
  pk_value: TValue;
  pk_field_type: string;
  pk_attribute_name, pk_field_name, SQL: string;
  Query: TADOQuery;
begin
  pk_idx := GetPKMappingIndex(AFieldsMapping);
  if pk_idx = -1 then
    raise Exception.Create('Invalid primary key for table ' + ATableName);
  pk_attribute_name := AFieldsMapping[pk_idx].name;
  pk_field_name := AFieldsMapping[pk_idx].FieldName;
  pk_field_type := AFieldsMapping[pk_idx].FieldType;
  pk_value := ARttiType.GetProperty(pk_attribute_name).GetValue(AObject);
  SQL := 'DELETE FROM ' + ATableName + ' WHERE ' + pk_field_name + ' = :'+pk_field_name;
  GetLogger.Debug('PREPARING: ' + SQL);
  Query := SS9.GetQuery;
  try
    Query.SQL.Text := SQL;
    SetADOParameterValue(Query, pk_field_name, pk_field_type, pk_value);
    Query.ExecSQL;
  finally
    //Query.Free;
  end;
  Result := nil;
end;

procedure TSqlServer9ADOPersistStrategy.DeleteAll(ATableName: string);
var
  SQL: string;
  Query: TADOQuery;
begin
  SQL := 'DELETE FROM ' + ATableName;
  Query := SS9.GetQuery;
  try
    Query.SQL.Text := SQL;
    GetLogger.Debug('EXECUTING :' + SQL);
    Query.ExecSql;
  finally
    //Query.Free;
  end;
end;

destructor TSqlServer9ADOPersistStrategy.Destroy;
begin
  SS9.Free;
  inherited;
end;

function TSqlServer9ADOPersistStrategy.EscapeDate(const Value: TDate): String;
begin
  Result := FormatDateTime('yyyymmdd', Value);
end;

function TSqlServer9ADOPersistStrategy.EscapeDateTime(const Value: TDate): String;
begin
  Result := FormatDateTime('yyyy-mm-dd"T"hh:mm:ss', Value);
end;

function TSqlServer9ADOPersistStrategy.EscapeString(const Value: String): String;
begin
  Result := StringReplace(Value, '''', '''''', [rfReplaceAll]);
end;

function TSqlServer9ADOPersistStrategy.ExecuteAndGetFirst(SQL: string): Int64;
var
  Query: TADOQuery;
begin
  Result := 0;
  Query := SS9.GetQuery;
  try
    Query.SQL.Text := SQL;
    GetLogger.Debug('EXECUTING :' + SQL);
    Query.Open;

    if Query.Eof then
      raise EdormException.Create('ExecuteAndGetFirst returns 0 rows')
    else
      Result := Query.Fields[0].AsInteger;

    Query.Close;
  finally
    //Query.Free;
  end;
end;

function TSqlServer9ADOPersistStrategy.GetKeyType: TdormKeyType;
begin
  Result := FKeyType;
end;

function TSqlServer9ADOPersistStrategy.GetLastInsertOID: TValue;
begin
  Result := FLastInsertOID;
end;

function TSqlServer9ADOPersistStrategy.GetLogger: IdormLogger;
begin
  Result := FLogger;
end;

procedure TSqlServer9ADOPersistStrategy.InitStrategy;
begin
  FLastInsertOID := TValue.Empty;
end;

function TSqlServer9ADOPersistStrategy.Insert(ARttiType: TRttiType; AObject: TObject;
  ATableName: string; AFieldsMapping: TMappingFieldList): TValue;
var
  field: TMappingField;
  sql_fields_names, sql_fields_values, SQL: string;
  Query: TADOQuery;
  pk_idx: Integer;
  v, pk_value: TValue;
begin
  sql_fields_names := '';
  for field in AFieldsMapping do
  begin
    if field.IsPK then Continue
    else sql_fields_names := sql_fields_names + ',' + field.FieldName;
  end;

  System.Delete(sql_fields_names, 1, 1);

  sql_fields_values := '';
  for field in AFieldsMapping do
  begin
    if field.IsPK then Continue
    else sql_fields_values := sql_fields_values + ',:'+field.FieldName;
  end;

  System.Delete(sql_fields_values, 1, 1);

  SQL := Format('INSERT INTO %s (%S) VALUES (%S)',
    [ATableName, sql_fields_names, sql_fields_values]);
  GetLogger.Debug('PREPARING :' + String(SQL));

  Query := SS9.GetQuery;
  Query.SQL.Text := SQL;
  try
    for field in AFieldsMapping do
    begin
      v := TdormUtils.GetField(AObject, field.name);

      if field.IsPK then
        Continue
      else
      begin
        SetADOParameterValue(Query, field.FieldName, field.FieldType, v);
      end;
    end;
    GetLogger.Debug('EXECUTING PREPARED :' + String(SQL));
    Query.ExecSql;
  finally
    //Query.Free;
  end;

  pk_value := SS9.GetLastKeyInserted;
  pk_idx := GetPKMappingIndex(AFieldsMapping);
  TdormUtils.SetProperty(AObject, AFieldsMapping[pk_idx].name, pk_value);
  Result := pk_value;
  FLastInsertOID := Result;
end;

function TSqlServer9ADOPersistStrategy.InTransaction: Boolean;
begin
  Result := SS9.GetConnection.InTransaction;
end;

function TSqlServer9ADOPersistStrategy.IsNullKey(const Value: TValue): Boolean;
begin
  case FKeyType of
    ktInteger:
      Result := Value.AsInt64 = FNullKeyValue.AsInt64;
    ktString:
      Result := Value.AsString = FNullKeyValue.AsString;
  else
    raise EdormException.Create('Unknown key type');
  end;
end;

function TSqlServer9ADOPersistStrategy.GetNullKeyValue: TValue;
begin
  Result := FNullKeyValue;
end;

function TSqlServer9ADOPersistStrategy.GetSelectSQL(Criteria: TdormCriteria; AMappingTable: TMappingTable): string;
var
  SQL: string;
  CritItem: TdormCriteriaItem;
  I: Integer;
  _fields: TMappingFieldList;
  fm: TMappingField;
  select_fields: string;
  d: TDate;
  dt: TDateTime;

  function GetFieldMappingByAttribute(AttributeName: string): TMappingField;
  var
    fm: TMappingField;
  begin
    for fm in _fields do
      if fm.name = AttributeName then
        Exit(fm);
    raise EdormException.CreateFmt('Unknown field attribute %s',
      [AttributeName]);
  end;

begin
  _fields := AMappingTable.Fields;
  select_fields := GetSelectFieldsList(_fields, true);
  if assigned(Criteria) and (Criteria.Count > 0) then
  begin
    SQL := 'SELECT ' + select_fields + ' FROM ' + AMappingTable.TableName +
      ' WHERE ';
    for I := 0 to Criteria.Count - 1 do
    begin
      CritItem := Criteria.GetCriteria(I);
      if I > 0 then
        case CritItem.LogicRelation of
          lrAnd:
            SQL := SQL + ' AND ';
          lrOr:
            SQL := SQL + ' OR ';
        end;
      fm := GetFieldMappingByAttribute(CritItem.Attribute);
      SQL := SQL + fm.FieldName;
      case CritItem.CompareOperator of
        coEqual:
          SQL := SQL + ' = ';
        coGreaterThan:
          SQL := SQL + ' > ';
        coLowerThan:
          SQL := SQL + ' < ';
        coGreaterOrEqual:
          SQL := SQL + ' >= ';
        coLowerOrEqual:
          SQL := SQL + ' <= ';
        coNotEqual:
          SQL := SQL + ' != ';
        coLike:
          SQL := SQL + ' LIKE ';
      end;

      if fm.FieldType = 'string' then
        SQL := SQL + '''' + EscapeString
          (CritItem.Value.AsString) + ''''
      else if fm.FieldType = 'uniqueidentifier' then
        SQL := SQL + '''' + EscapeString
          (CritItem.Value.AsString) + ''''
      else if fm.FieldType = 'integer' then
        SQL := SQL + inttostr(CritItem.Value.AsInteger)
      else if fm.FieldType = 'boolean' then
        SQL := SQL + BoolToStr(CritItem.Value.AsBoolean)
      else if fm.FieldType = 'date' then
      begin
        d := CritItem.Value.AsExtended;
        SQL := SQL + '''' + EscapeDate(d) + ''''
      end
      else if (fm.FieldType = 'timestamp') or (fm.FieldType = 'datetime') then
      begin
        dt := CritItem.Value.AsExtended;
        SQL := SQL + '''' + EscapeDateTime(dt) + ''''
      end
      else
        raise EdormException.CreateFmt('Unknown type %s in criteria',
          [fm.FieldType]);
    end;
  end
  else // Criteria is nil or is empty
    SQL := 'SELECT ' + select_fields + ' FROM ' + AMappingTable.TableName + ' ';
  Result := SQL;
end;

function TSqlServer9ADOPersistStrategy.List(ARttiType: TRttiType; ATableName: string;
  AFieldsMapping: TMappingFieldList;
  AdormSearchCriteria: IdormSearchCriteria): TObjectList<TObject>;
begin
  Result :=NewList();
  FillList(Result, ARttiType, ATableName, AFieldsMapping, AdormSearchCriteria);
end;

procedure TSqlServer9ADOPersistStrategy.FillList(AList: TObject;
  ARttiType: TRttiType; ATableName: string;
  AFieldsMapping: TMappingFieldList;
  AdormSearchCriteria: IdormSearchCriteria);
var
  SQL: string;
  Query: TADOQuery;
begin
  SQL := AdormSearchCriteria.GetSQL;
  GetLogger.Debug('PREPARING: ' + SQL);
  Query := SS9.GetQuery;
  Query.SQL.Text := SQL;
  try
    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);
    Query.Open;
    try
      while not Query.Eof do
      begin
        TdormUtils.MethodCall(AList, 'Add', [CreateObjectFromADODataSet(ARttiType, Query,
          AFieldsMapping)]);
        Query.Next;
      end;
    finally
      Query.Close;
    end;
  finally
    //Query.Free;
  end;
end;

function TSqlServer9ADOPersistStrategy.Load(ARttiType: TRttiType; ATableName: string;
  AFieldsMapping: TMappingFieldList; const Value: TValue): TObject;
var
  pk_idx: Integer;
  pk_attribute_name, pk_field_name, SQL: string;
  Query: TADOQuery;
begin
  Result := nil;
  pk_idx := GetPKMappingIndex(AFieldsMapping);
  if pk_idx = -1 then
    raise Exception.Create('Invalid primary key for table ' + ATableName);
  pk_attribute_name := AFieldsMapping[pk_idx].name;
  pk_field_name := AFieldsMapping[pk_idx].FieldName;
  SQL := 'SELECT ' + GetSelectFieldsList(AFieldsMapping, true) + ' FROM ' +
    ATableName + ' WHERE ' + pk_field_name + ' = :'+pk_field_name;
  GetLogger.Debug('PREPARING: ' + SQL);
  Query := SS9.GetQuery;
  Query.SQL.Clear;
  Query.SQL.Add(SQL);
  try
    FillPrimaryKeyParam(Query,pk_field_name, Value);
    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);
    Query.Open;
    try
      while not Query.Eof do
      begin
        Result := CreateObjectFromADODataSet(ARttiType, Query, AFieldsMapping);
        Query.Next;
      end;
    finally
      Query.Close;
    end;
  finally
    //Query.Free;
  end;
end;

function TSqlServer9ADOPersistStrategy.LoadObjectFromADODataset(ARttiType: TRttiType; ADataset: TADOQuery;
  AFieldsMapping: TMappingFieldList; AObject: TObject): Boolean;
var
  obj: TObject;
  field: TMappingField;
  v: TValue;
begin
  obj := AObject;
  for field in AFieldsMapping do
  begin
    if CompareText(field.FieldType, 'string') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsString
    else if CompareText(field.FieldType, 'integer') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsInteger
    else if CompareText(field.FieldType, 'date') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsDateTime
    else if CompareText(field.FieldType, 'datetime') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsDateTime
    else if CompareText(field.FieldType, 'timestamp') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsDateTime
    else if CompareText(field.FieldType, 'decimal') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsFloat
    else if CompareText(field.FieldType, 'numeric') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsFloat
    else if CompareText(field.FieldType, 'float') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsFloat
    else if CompareText(field.FieldType, 'money') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsCurrency
    else if CompareText(field.FieldType, 'boolean') = 0 then
      v := ADataset.FieldByName(field.FieldName).AsBoolean
    else
      raise Exception.Create('Unknown field type for ' + field.FieldName);
    TdormUtils.SetField(obj, field.FieldName, v);
  end;
  Result := true;
end;

function TSqlServer9ADOPersistStrategy.RawExecute(SQL: string): Int64;
var
  Query: TADOQuery;
begin
  Result := -1;
  GetLogger.Warning('RAW EXECUTED: ' + SQL);

  Query := SS9.GetQuery;
  try
    Query.SQL.Text := SQL;
    Query.ExecSQL;
  finally
    //Query.Free;
  end;
end;

function TSqlServer9ADOPersistStrategy.CreateObjectFromADODataset(ARttiType: TRttiType; ADataSet: TADOQuery; AFieldsMapping: TMappingFieldList): TObject;
var
  obj: TObject;
  field: TMappingField;
  v: TValue;
  S: string;
  targetStream: TMemoryStream;
  blobfield: TBlobField;
begin
  try
    obj := TdormUtils.CreateObject(ARttiType);
    for field in AFieldsMapping do
    begin
      if CompareText(field.FieldType, 'string') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsString;
        S := field.FieldName + ' as string';
      end
      else if CompareText(field.FieldType, 'integer') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsInteger;
        S := field.FieldName + ' as integer';
      end
      else if CompareText(field.FieldType, 'date') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsDateTime;
        S := field.FieldName + ' as date';
      end
      else if CompareText(field.FieldType, 'datetime') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsDateTime;
        S := field.FieldName + ' as datetime';
      end
      else if CompareText(field.FieldType, 'timestamp') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsDateTime;
        S := field.FieldName + ' as timestamp';
      end
      else if CompareText(field.FieldType, 'decimal') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsFloat;
        S := field.FieldName + ' as decimal';
      end
      else if CompareText(field.FieldType, 'numeric') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsFloat;
        S := field.FieldName + ' as numeric';
      end
      else if CompareText(field.FieldType, 'float') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsFloat;
        S := field.FieldName + ' as float';
      end
      else if CompareText(field.FieldType, 'money') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsCurrency;
        S := field.FieldName + ' as money';
      end
      else if CompareText(field.FieldType, 'blob') = 0 then
      begin
        if ADataSet.FieldByName(field.FieldName).IsNull then
        begin
          v := nil;
        end else
        begin
          blobfield := TBlobField(ADataSet.FieldByName(field.FieldName));
          targetStream := TMemoryStream.Create;
          blobfield.SaveToStream(targetStream);
          S := field.FieldName + ' as blob';
          v := targetStream;
        end;
      end
      else if CompareText(field.FieldType, 'boolean') = 0 then
      begin
        v := ADataSet.FieldByName(field.FieldName).AsBoolean;
        S := field.FieldName + ' as boolean';
      end
      else
        raise Exception.Create('Unknown field type for ' + field.FieldName);
      try
        TdormUtils.SetField(obj, field.name, v);
      except
        on E: Exception do
        begin

          raise EdormException.Create(E.Message + sLineBreak +
            '. Probably cannot write ' + ARttiType.ToString + '.' + S);
        end;
      end;
    end;
  except
    on E: Exception do
    begin

      raise;
    end;
  end;
  Result := obj;
end;

class procedure TSqlServer9ADOPersistStrategy.register;
begin
  //
end;

procedure TSqlServer9ADOPersistStrategy.Rollback;
begin
  //if SS9.GetConnection.InTransaction then SS9.GetConnection.RollbackTrans;
end;

procedure TSqlServer9ADOPersistStrategy.SetLogger(ALogger: IdormLogger);
begin
  FLogger := ALogger;
end;

procedure TSqlServer9ADOPersistStrategy.StartTransaction;
begin
  (*
  if SS9.GetConnection.InTransaction then
    raise Exception.Create('Transaction already active')
  else
    SS9.GetConnection.BeginTrans;
    *)
end;

procedure TSqlServer9ADOPersistStrategy.SetADOParameterValue(aQuery: TADOQuery; aParamName: string; aFieldType: string; aValue: TValue);
var sourceStream: TStream;
    str: TBytesStream;
begin
  if CompareText(aFieldType, 'blob') = 0 then
  begin
    sourceStream := TStream(aValue.AsObject);
    if sourceStream = nil then
      aQuery.Parameters.ParamByName(aParamName).Value := NULL
    else
    begin
      str := TBytesStream.Create;
      try
        try
          sourceStream.Position := 0;
          str.CopyFrom(sourceStream, sourceStream.Size);
          str.Position := 0;
          aQuery.Parameters.ParamByName(aParamName).LoadFromStream(str, ftBlob);
        except
          raise;
        end;
      finally
        str.Free;
      end;
    end;
  end
  else
  begin
    aQuery.Parameters.ParamByName(aParamName).Value := aValue.AsVariant;
  end;
end;

function TSqlServer9ADOPersistStrategy.FillPrimaryKeyParam(Query: TADOQuery;
  AParamName: String; const Value: TValue): TValue;
begin
  try
    case FKeyType of
      ktString:
        begin
          raise EdormException.Create
            (ClassName + ' do not support string primary keys');
        end;
      ktInteger:
        begin
          Query.Parameters.ParamByName(AParamName).Value := Value.AsInteger;
          Result := Value.AsInteger;
        end;
    end;
  except
    on E: Exception do
      raise EdormException.Create('Error during fill primary key for query. ' +
        E.Message);
  end;
end;

{ TSQLServer9ADOIdentity }

function TSQLServer9ADOIdentity.NewIntegerKey(const Entity: string): UInt64;
begin
  Result := 1;
  // do nothing
end;

function TSQLServer9ADOIdentity.NewStringKey(const Entity: string): string;
begin
  Result := '';
  // do nothing
end;

class procedure TSQLServer9ADOIdentity.RegisterClass;
begin
  // do nothing
end;

procedure TSQLServer9ADOIdentity.SetPersistStrategy(const PersistentStrategy
  : IdormPersistStrategy);
begin
  FPersistStrategy := PersistentStrategy;
end;

initialization

TSqlServer9ADOPersistStrategy.Register;
TSQLServer9ADOIdentity.RegisterClass;

finalization

end.
